home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 21
/
Cream of the Crop 21 (Terry Blount) (October 1996).iso
/
doom
/
quake.zip
/
XPAK040.ZIP
/
XPAK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-07-02
|
35KB
|
1,041 lines
program xPak; (* .PAK file manipulator *)
{$M 16384,102400,655360} {Enough heap to load PAK0.PAK directory min}
uses wildmat,dos,crt;
const
LUMP_NAME_SIZE = $40-8;
END_CHARS = [#10,#0];
PAK_HEADER = 'PACK';
PAK_PROTECTED = 'PAK0.PAK';
MAX_BLOCK_SIZE:word = 65528;
{HALT codes, not fully implemented yet}
HALT_PARSE = 1;
HALT_SAFETY = 3;
HALT_QUIT = 4;
type
Buffer= array[1..65528] of byte;
LumpNameType= array[1..LUMP_NAME_SIZE] of char;
Modes=(None,List,Extract,Add,Remove,Rename,Merge);
DirEntry=record
Lumpname : LumpNameType;
Pos : Longint;
Size : LongInt;
end;
PFileSpecList=^TFileSpecList;
TFileSpecList=record
FileSpec : string[140];
LumpName : string[LUMP_NAME_SIZE];
Remapped : boolean;
included : boolean;
Next : PFileSpecList;
end;
PMasterDir=^TMasterDir;
TMasterDir=record {212 bytes}
Dir : DirEntry;
Filename : string[140];
Prev : PMasterDir;
Next : PMasterDir;
end;
TFlags=record
Override : boolean;
Verbose : boolean;
Force : boolean;
Interact : boolean;
Query : boolean;
AccessPAK: boolean;
Backup : boolean;
JustName : boolean;
Debug : boolean;
end;
var
Flags: TFlags;
{ o: text;}
procedure Help;
begin
Writeln('usage: xpak <pakfile> -l|-e|-a|-r|-n [lumpname:]filespec [switches]');
Writeln;
Writeln('Command line must contain *one* of the following switches:');
writeln(' (r) = read; (c) = create; (m) = modify');
writeln(' -l (r) List contents of PAK file');
writeln(' -e (r) Extract specified files to directory tree');
writeln(' -a (c) Add specified files to PAK file (also create and update files)');
writeln(' -r (m) Remove specified lumps');
writeln(' -n (m) Rename lump in PAK file (renames to :filename');
writeln('Notice: -u and old -c have been removed. They have been integrated into -a');
writeln(#13#10,'Press any key for next page');ReadKey;
writeln(#13#10,'Modification switches:');
writeln(' -o Overrides some of the safety features in xpak. These include');
writeln(' not writing to ID1.PAK and requiring existance of ./quake.exe');
writeln(' -j (with -l) display just names only (useful to create @file lists)');
writeln(' -v verbose mode. Display names of lumps during processing.');
writeln(' -d debug mode. Displays all sorts of useless debugging info.');
writeln(' -i (with -e) Interactive mode. Prompt to overwrite files');
writeln(' -f (with -e) Force overwrites. Default is to skip existing files');
writeln(' # -q Query mode, ask before adding/extracting/removing each file');
writeln(' # -b backup PAK file before modification / existing extract targets');
writeln;
writeln('Lump names may be specified as free * and ? wildcards, but filenames');
writeln('(excludes -e) require DOS style paths and wildcards. To access a lump name');
writeln('with a different filename, use the syntax lumpname:filename. Wildcards not');
writeln('allowed. File lists can be referenced as @filename. # denotes comment line');
writeln;
writeln('Remember that this is an early version, and may have ''problems'' =) Note also');
writeln('that xpak is now more-or-less unsupported, as I am working on a rewrite, sixpak');
halt;
end;
procedure Lower4(var Str: String);
InLine( {Adapted From SWAG}
$8C/$DA/$5E/$1F/$FC/$AC/$30/$E4/$89/$C1/$E3/$12/$BB/Ord('A')/Ord('Z')/
$AC/$38/$D8/$72/$08/$38/$F8/$77/$04/$80/$44/$FF/$20/$E2/$F1/$8E/$DA);
procedure cvBackSlash(var ForeStr: string);
var i: byte;
begin
for i:=1 to Length(ForeStr) do
if ForeStr[i]='/' then ForeStr[i]:='\';
end;
procedure cvForeSlash(var BackStr: string);
var i: byte;
begin
for i:=1 to Length(BackStr) do
if BackStr[i]='\' then BackStr[i]:='/';
end;
procedure SetStr(var st:string; const ar:LumpNameType);
var
i: byte;
begin
st:='';
for i:=1 to LUMP_NAME_SIZE do
begin
if ar[i] in END_CHARS then begin dec(i); break end;
st[i]:=ar[i];
end;
st[0]:=Char(i);
end;
procedure SetArr(var ar: LumpNameType; const st:string);
var
i,j: byte;
begin
FillChar(ar,SizeOf(ar),0);
j:=Length(st);
if Length(st)>LUMP_NAME_SIZE then j:=LUMP_NAME_SIZE;
for i:=1 to j do
ar[i]:=st[i];
end;
function Exist(const filename:string): boolean;
var
DirInfo:SearchRec;
begin
FindFirst(filename,Anyfile,DirInfo);
Exist:=(DosError=0);
end;
function MakePAKFilename(const oldname:string):string;
begin
if Pos('.',oldname)>0 then
MakePAKFilename:=oldname
else
MakePAKFilename:=oldname+'.pak';
end;
procedure AddFileSpec(fs:string; yn: boolean; var TempPos: PFileSpecList);
var
spec,lump:string;
cpos: byte;
remap:boolean;
begin
lump:=fs;spec:=fs;
cpos:=pos(':',fs);
remap:=false;
if cpos>0 then
begin
if pos('*',fs)>0 then
begin writeln('addspec: no wildcards allowed with alternate filenames (yet)'); exit end;
if pos('?',fs)>0 then
begin writeln('addspec: no wildcards allowed with alternate filenames (yet)'); exit end;
lump:=Copy(fs,1,cpos-1);
spec:=Copy(fs,cpos+1,255);
remap:=true;
end;
New(TempPos^.Next);
TempPos:=TempPos^.Next;
cvBackslash(spec);
cvForeslash(lump);
Lower4(lump);
TempPos^.Filespec:=spec;
TempPos^.Lumpname:=lump;
TempPos^.Included:=yn;
TempPos^.Remapped:=remap;
TempPos^.Next:=nil;
end;
procedure FromFile(fn:string;Incl: boolean; var ListTemp: PFileSpecList);
var
ff: text;
fs: string;
begin
if fn[1]='@' then Delete(fn,1,1);
Assign(ff,fn);
{$I-}
Reset(ff);
if IOResult<>0 then
begin writeln('parse: unable to open filespec list file.'); exit end;
{$I+}
while not eof(ff) do
begin
ReadLn(ff,fs);
if fs<>'' then
if fs[1]<>'#' then
if fs[1]='!' then
AddFileSpec(Copy(fs,2,Length(fs)-1),not incl,ListTemp)
else
AddFileSpec(fs,incl,ListTemp);
end;
end;
function CheckParams(var MainPAK:string; var Files: PFileSpecList):Modes;
var
Param:string;
i:byte;
TempSpec:PFileSpecList;
SpecStart: PFileSpecList;
TempMode: Modes;
Include: boolean;
begin
TempMode:=None;Include:=True;MainPAK:='';
FillChar(Flags,SizeOf(Flags),0);
New(Files); TempSpec:=Files;
TempSpec^.Filespec:='*';
TempSpec^.Included:=True;
TempSpec^.Next:=nil;
if ParamCount=0 then begin writeln('Type `xpak -?` for help.');halt end;
for i:=1 to ParamCount do
begin
Param:=ParamStr(i);
If Param[1]='-' then
if Length(Param)=1 then begin Writeln('parse: bad parameter ',Param);halt(1) end
else
Case UpCase(Param[2]) of
'?': Help;
'B': Flags.Backup:=True;
'D': Flags.Debug:=True;
'F': Flags.Force:=True;
'I': Flags.Interact:=True;
'J': Flags.JustName:=True;
'O': Flags.Override:=True;